perm filename CC[MEW,AIL] blob sn#091937 filedate 1974-03-17 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00017 PAGES VERSION 0(0)
RECORD PAGE   DESCRIPTION
 00001 00001
 00003 00002	TENX<TENEX COMMAND SCANNER
 00005 00003	DSCR	COMND
 00009 00004	CMDSCN:	
 00014 00005	GOSUB:	IDPB	A,CMDPTR		SAVE WHATEVER CHAR IT WAS
 00015 00006	SUBCMD:	SKIPE	RPGSW
 00016 00007	
 00018 00008	GETLST:
 00019 00009	PSWIT:
 00021 00010	DONE:	
 00023 00011	DSCR	Routines to print out info
 00025 00012	
 00026 00013	DSCR	Typing routines
 00027 00014	DSCR	Long form GTJFN tables.
 00029 00015	
 00034 00016	
 00035 00017	
 00036 ENDMK
⊗;
TENX<;TENEX COMMAND SCANNER


ZERODATA (TENEX COMMAND SCANNER)

?BINJFN: 0
?LISJFN: 0
;SRCJFN is in switched/cleared area, along with SRCFLN
?DEFFLN: BLOCK 11		;DEFAULT FILE NAME FOR .LST, .REL FILES
SAIJFN:	0
?TTYSRC:0			;TRUE IF SOURCE IS THE CONTROLLING TERMINAL
NAMPTR:	0
SAVEP:	0
NXTPTR:	0
NAMES:	BLOCK 50		;ENOUGH FOR A LOT OF CHARS!
?CMDLIN:BLOCK 100		;COMMAND LINE
CMDPTR:	0			;POINTS TO COMMAND LINE
CMDJFN:	0			;JFN FOR COMMANDS

SWTTXT:	BLOCK 10		;TEXT FOR SWITCHES
SWTPTR:	0			;POINTER TO ABOVE


RFMODB:	0			;TEMPORARIES FOR TTY MODE SETTINGS
RFCOCB:	0
RFCOCC:	0

LODMOD:	0			;SET TO TRUE IF LOADING
LODDDT:	0			;LOADING WITH DDT
LODSDT:	0			;LOADING WITH SDDT

ENDDATA

DATA
HRLDON:	0			;TRUE IF WE HAVE PRINTED THE MESSAGE ONCE
ENDDATA

HERALD:	BLOCK 25		;PUT IN HIGH CORE SINCE WE WILL SET IT THEN 
				;SSAVE CORE IMAGE AFTER LOADING
DSCR	COMND

CAL	PUSHJ

RET	+1 if unsuccessful
	+2 if successful

⊗

	
COMND:	
IMSSS<
	SKIPN	RPGSW		;CALLED IN RPGMODE?
	  JRST	NORPG		;NO

;DAMNED IMSSS EMULATOR IS CAUSING THE NEXT KLUDGE
	SETO	A,		;SET TO CLEAR
	HRRZ	B,JOBREL
	LSH	B,-11		;MAKE A PAGE NO.
	ADDI	B,1
	HRLI	B,400000	;THIS FORK
	SETZ	C,
	JSYS	PMAP
	MOVE	B,[XWD 400000,711]	
	JSYS	PMAP

	SETO	A,
	MOVEI	B,TMPCBF	;GET BUFFER
	JSYS	GTINF	
	  JFCL
	SKIPN	TMPCBF+6	;SOMETHING THERE?
	  JRST	NORPG
	HRROI	A,[ASCIZ/
Tenex SAIL:
/]
	JSYS	PSOUT
	MOVE	A,[POINT 7,TMPCBF+6,-1]	;BP
	MOVEM	A,CMDJFN	;USE FOR THE COMMAND SOURCE	
;	JSYS	PSOUT
	CAIA			;SKIP OVER SETZM
NORPG:	
>;IMSSS
NOIMSSS<
	SETZM	RPGSW
>;NOIMSSS
	SETZM	CMDJFN		;START WITH NOTHING

	MOVEI	A,101		;SET TTY FOR COMMAND SCANNER
	JSYS	RFMOD
	MOVEM	B,RFMODB
	TRO	B,170000	;WAKE UP ON EVERYTHING
	JSYS	SFMOD
	MOVEI	A,101
	JSYS	RFCOC
	MOVEM	B,RFCOCB
	MOVEM	C,RFCOCC
	TRZ	B,006000	;NOTHING FOR ↑L
	TRZ	C,600000	;NOTHING FOR ↑R
	JSYS	SFCOC		

	PUSHJ	P,CMDSCN	;GET BIN AND LST JFN'S

	MOVEI	A,101		;RESET TTY MODES
	MOVE	B,RFMODB
	JSYS	SFMOD
	MOVEI	A,101
	MOVE	B,RFCOCB
	MOVE	C,RFCOCC
	JSYS	SFCOC

	TLZ	FF,LISTNG+BINARY;ASSUME NEITHER
	MOVE	A,BINJFN	
	JUMPL	A,TRYLST	;NO BIN FILE
	MOVE	B,[XWD 440000,100000] ;OPEN BINARY FILE
	JSYS	OPENF
	  JRST	NOBIN		;CAN'T OPEN IT
	TLO	FF,BINARY	;MADE IT
TRYLST:	MOVE	A,LISJFN
	JUMPL	A,GETSRC	;NO LISTING,GO ON TO SRC
	MOVE	B,[XWD 70000,100000]
	JSYS	OPENF
	  JRST	NOLST2		;NO CAN DO
	TLO	FF,LISTNG
	JRST	GETSRC		;ACTUALLY READ THE SOURCE FILE NOW

NOBIN:	ERR	<Cannot OPENF binary file.>
	JRST	TRYLST
NOLST2:	ERR	<Cannot OPENF listing file.>
	JRST	GETSRC

EOLC ←← 37
COMMA ←← ","
ESCAPE ←← 33
SWCH ←← "@"
QRBOUT ←← 177		;abort command on rubout
CTRLU←←"U"-100		;also on control-U
QMARK←←"?"		;for help
CTRLR←←"R"-100		;for .REL file
SLASH←←"/"		;for switches
SPACE←←" "		;SPACE
CTRLL←←"L"-100		;for .LST file
CTRLQ←←"Q"-100		;for halting
CTRLX←←"X"-100
CTRLA←←"A"-100
SRCBSZ←←200		;SIZE IN WRDS OF SRC FILE BUFFERS


DEFINE BACKUP <PUSHJ P,.BACKUP>		;BACK UP POINTER OR JFN
DEFINE NXTCHR <PUSHJ P,.NXTCHR>		;GET THE NEXT CHAR
CMDSCN:	
	SKIPN	RPGSW			;IF IN RPG MODE
	SKIPE	HRLDON			;OR ALREADY PRINTED HERALD 
 	  JRST	NOHRLD			;THEN DONT PRINT AGAIN
	HRROI	A,HERALD
	JSYS	PSOUT
NOHRLD:
	SETOM	HRLDON
	MOVEM	P,SAVEP
GETSAI:	MOVE	A,[POINT 7,NAMES,-1]
	MOVEM	A,NAMPTR
	MOVE	A,[POINT 7,CMDLIN,-1]
	MOVEM	A,CMDPTR
	SETZM	LODDDT
	SETZM	LODMOD
	SETZM	LODSDT
	SETZM	DEFFLN			;MARK THAT WE DONT YET HAVE A DEFAULT NAME
	SETOM	LISJFN			;ASSUME NO LISTING FILE
	SETZM	BINJFN			;ASSUME WANT A BINARY
	SKIPE	RPGSW
	  JRST	.+3
	HRROI	A,[ASCIZ/
*/]
	JSYS	PSOUT
GETSA1:	MOVEI	D,GETSAI		;FOR ERROR RETURN
	NXTCHR				;PEEK AHEAD BEFORE GTJFN
	CAIN	A,QMARK			;A QUESTION MARK?
	   JRST	QUERY			;AND RETURN TO GETSAI
	BACKUP				;BUT DONT GET CARRIED AWAY WITH PEEKING!
GETSA2:	MOVEI	A,ESAI
	MOVE	B,CMDJFN		;START WITH INPUT FROM HERE
	JSYS	GTJFN
	  JRST	.+2
	JRST	GOTSAI
	MOVEM	B,CMDJFN		;SAVE POINTER
	MOVE	B,A			;SAVE ERROR NUMBER
	BACKUP	
	NXTCHR
	CAIE	A,"←"			;PERHAPS DOES NOT WANT A BINARY
	  JRST	.+4
	 SETOM	BINJFN			;INDICATE NO BINARY
	 IDPB	A,CMDPTR
	 JRST	GETSA1
	CAIE	A,QRBOUT	
	CAIN	A,CTRLU
	  JRST	CMDRES			;RESET COMMAND THING
	CAIN	A,CTRLQ
	  JRST	DOHLT
	CAIN	B,600115		;NULL COMMAND -- ALLOW IT
	  JRST	GETSAI			;REPRINT "*" AND DO ANOTHER GTJFN
	JRST	ERROR			;SOMETHING ELSE IS WRONG -- TELL THE USER

GOTSAI:	MOVEM	A,SAIJFN		;SAVE THE JFN
	MOVEM	B,CMDJFN
	MOVE	A,NAMPTR
	HRRZ	B,SAIJFN
	SETZ	C,
	JSYS	JFNS
	MOVEM	A,NAMPTR

	MOVE	A,CMDPTR
	HRRZ	B,SAIJFN
	MOVE	C,[XWD 221100,1]
	JSYS	JFNS
	MOVEM	A,CMDPTR
	
	SKIPE	DEFFLN			;DO WE ALREADY HAVE A DEFAULT NAME?
	  JRST	GTDFFN			;YES
	HRROI	A,DEFFLN		;GET THE DEFAULT FILENAME FOR OTHER THINGS
	HRRZ	B,SAIJFN	
	MOVSI	C,2000			;FILENAME ONLY
	JSYS	JFNS
	SETZ	C,0
	IDPB	C,A			;PUT A NULL BYTE ON THE END

GTDFFN:	HRRZ	A,SAIJFN		;GET RID OF SOURCE JFN FOR NOW
	JSYS	RLJFN
	  JFCL

	BACKUP
	NXTCHR
	CAIN	A,ESCAPE
	  NXTCHR
	CAIN	A,CTRLQ
	  JRST	DOHLT
	CAIN	A,CTRLU
	  JRST	CMDRES
        CAIE	A,"←"			;
	   JRST NOWNLD
	IDPB	A,CMDPTR		;SAVE IT I GUESS
	SETOM	LODMOD			;
	SETOM	LODDDT
	JRST	DONE			;MUST BE DONE -- TYPED AN ARROW
NOWNLD:
	CAIN	A,EOLC			;DONE IF EOL
	  JRST 	DONE
	CAIE	A,COMMA			;IS IT A COMMA
	  JRST	DUNCMA			;NO -- RANDOM FILE CHARACTER?
ISCMA:	IDPB	A,CMDPTR		;SAVE THE COMMA
	NXTCHR
	CAIE	A,EOLC			;IF AN EOL
	CAIN	A,SPACE			;OR SPACE
	  JRST	GOSUB			;THEN SUBCOMMAND
	CAIN	A,"←"			;ARROW MEANS
	  JRST	[SETOM	LODMOD
		 SETOM LODDDT
		 JRST	GOSUB]
DUNCMA:	BACKUP				;MUST BE A FILE NAME -- PUT THE CHAR BACK
	SETZ	A,
	IDPB	A,NAMPTR		;SEPARATE THE NAMES WITH NULLS
	JRST	GETSA2			;FOR GTJFN

GOSUB:	IDPB	A,CMDPTR		;SAVE WHATEVER CHAR IT WAS
	SKIPE	RPGSW
	  JRST	SUBCMD
	HRROI	A,[ASCIZ/
/]
	JSYS	PSOUT
	
SUBCMD:	SKIPE	RPGSW
	   JRST	.+3
	HRROI	A,[ASCIZ/**/]
	JSYS	PSOUT
	MOVEI	D,SUBCMD		;SET TO RETURN TO SUBCMD
	NXTCHR				;GET THE NEXT CHARACTER	
	CAIN	A,QMARK			;QUERY
	  JRST	SUBQRY
	CAIN	A,EOLC			;DONE?
	  JRST	DONE			;YEP
	CAIN	A,CTRLL			;FOR LISTING?
	  JRST	GETLST
	CAIN	A,CTRLR			;NON-STANDARD .REL FILE
	  JRST	GETREL			;GET ONE FROM THE USER
	CAIN	A,SLASH			;SWITCH?
	  JRST	PSWIT			;		
	CAIN	A,CTRLQ			
	  JRST	DOHLT
	CAIN	A,CTRLU
	  JRST	CMDRES
	JRST	SUBCMD			;KEEP LOOPING	


GETREL:
	SKIPE	RPGSW
	  JRST	.+3
	HRROI	A,[ASCIZ/REL file  */]
	JSYS	PSOUT
	MOVEI	A,EREL			;addr. of tbl for long GTJFN
	MOVE	B,CMDJFN		;MAIN STRING POINTER IF ANY
	JSYS	GTJFN	
	  JRST	[MOVEM B,CMDJFN
		 JRST	ERROR]		;NOTE THAT ERROR RETURNS TO SUBCOMMAND LEVEL IN THIS CASE
	MOVEM	A,BINJFN		;SAVE JFN
	MOVEM	B,CMDJFN		;possibly an updated BP
	BACKUP
	NXTCHR
	CAIN	A,ESCAPE		;GET ANOTHER CHAR IF TERM WITH ALTMODE
	  NXTCHR
	MOVEI	A,CTRLR			;MARK THE COMMAND
	IDPB	A,CMDPTR			
	HRRZ	B,BINJFN	;ONLY RH BITS
	MOVE	A,CMDPTR		;SAVE THE JFN
	MOVE	C,[XWD 221100,000001]	;ITS ANYBODY'S GUESS IF THIS IS RIGHT!
	JSYS	JFNS		;PUT BINARY NAME INTO CMDLIN
	MOVEI	C,EOLC			;
	IDPB	C,A			;AN EOL
	MOVEM	A,CMDPTR
	TLO	FF,BINARY		;INDICATE BINARY FOR A BIT
	JRST	SUBCMD			;AND STAY IN SUBCOMMAND MODE
GETLST:
	SKIPE	RPGSW
	  JRST	.+3
	HRROI	A,[ASCIZ/LST file  */]
	JSYS	PSOUT
	MOVEI	A,ELST
	MOVE	B,CMDJFN
	JSYS	GTJFN
	  JRST	[MOVEM B,CMDJFN
		 JRST	ERROR]		
	MOVEM	A,LISJFN
	MOVEM	B,CMDJFN
	BACKUP
	NXTCHR
	CAIN	A,ESCAPE		;IF TERMINATED WITH ESCAPE THEN
	  NXTCHR			;GET ANOTHER CHAR
	MOVEI	A,CTRLL
	IDPB	A,CMDPTR
	HRRZ	B,LISJFN
	MOVE	A,CMDPTR
	MOVE	C,[XWD 221100,000001]
	JSYS	JFNS
	MOVEI	C,EOLC			;PUT AN EOL
	IDPB	C,A			;AT THE END OF THE COMMAND BUFFER
	MOVEM	A,CMDPTR
	TLO	FF,LISTNG		;INDICATE LISTING FOR A BIT
	JRST	SUBCMD
PSWIT:
	MOVE	D,[POINT 7,SWTTXT,-1]	;BYTE POINTER TO STRING
	SETZ	5,			;CHAR COUNT
PSWLUP:	NXTCHR
	CAIN	A,CTRLQ			;QUIT?
	  JRST	DOHLT			
	CAIN	A,CTRLU			;RESET COMMAND
	  JRST	CMDRES
	CAIE	A,CTRLR			;REPEAT LINE?
	  JRST	NORPT	
DOCTR:	HRROI	A,[ASCIZ!
/!]
	JSYS	PSOUT
	JUMPE	5,PSWLUP
	MOVEI	A,101
	MOVE	B,[POINT 7,SWTTXT,-1]
	MOVN	C,5			;COUNT
	JSYS	SOUT
	  JRST	PSWLUP			;AND CONTINUE
NORPT:	CAIE	A,CTRLX			;RUBOUT (WHICH GOES TO SUBCOMMAND LEVEL)
	  JRST	NOCTX
DOCTX:	HRROI	A,[ASCIZ/
/]
	JSYS	PSOUT
	JRST	SUBCMD
NOCTX:	CAIE	A,QRBOUT
	CAIN	A,CTRLA
	  JRST  .+2	
	JRST	NOCTA	   
	JUMPLE 	5,DOCTX
	MOVEI	A,"\"
	JSYS	PBOUT
	LDB	A,D			;LAST CHAR
	JSYS	PBOUT
	MOVE	A,D
	JSYS	BKJFN			;BACK UP THE BP
	  JFCL
	MOVEM	A,D
	SOJA	5,PSWLUP		;DECREMENT COUNT AND CONTINUE

NOCTA:	CAIE	A,EOLC
	CAIN	A,ESCAPE
	  JRST	PSWDUN
	IDPB	A,D
	AOJA	5,PSWLUP		;LOOK FOR MORE
PSWDUN:	
	SETZ	A,
	IDPB	A,D			;PUT A NULL BYTE
	MOVEI	A,SLASH

	IDPB	A,CMDPTR		;SAVE THE SWITCH
	MOVE	A,[POINT 7,SWTTXT,-1]
	MOVE	B,CMDPTR
	SETZ	C,
	JSYS	SIN
	MOVEI	C,EOLC
	IDPB	C,B
	MOVEM	B,CMDPTR
	MOVE	A,[POINT 7,SWTTXT,-1]	
	MOVEM	A,SWTPTR
	JSP	PNT,SWTGET		;PROCESS THE SWITCH
	JRST	SUBCMD			;MORE SUBCOMMANDS?
DONE:	
	MOVEI	A,EOLC
	IDPB	A,CMDPTR
	IDPB	A,NAMPTR
	HRROI	A,NAMES
	MOVEM	A,NXTPTR
	SKIPE	BINJFN			;ALREADY DECIDED ABOUT BINARY
	  JRST	DONE1			;YES
	MOVEI	D,CMDSCN		;BE READY TO START OVER
	MOVEI	A,EREL1			;NO EXTRA JFNS, NO CONFIRM
	HRROI	B,DEFFLN		;USE THE DEFAULT NAME
	JSYS	GTJFN
	   JRST	ERROR			;SOMETHING IS WRONG
	MOVEM	A,BINJFN		;GOT IT
	TLO	FF,BINARY		;INDICATE BINARY FOR A BIT
DONE1:	POPJ	P,

CMDRES:	HRROI	A,[ASCIZ/
Restarting ...
/]
	JSYS	PSOUT
	JRST	SAIL			;ALL OVER AGAIN

;HERE TO PRINT OUT LAST ERROR, RETURN ADDRESS IN D
ERROR:	HRROI	A,[ASCIZ/
/]
	JSYS	PSOUT
	MOVEI	A,101			;PRIMARY OUTPUT
	MOVE	B,[XWD 400000,-1]	;THIS FORK, MOST RECENT ERROR
	SETZ	C,
	JSYS	ERSTR
	  JFCL
	  SKIPA	A,[POINT 7,[ASCIZ/Cannot find TENEX error message.
/],-1]
	HRROI	A,[ASCIZ/
/]
	JSYS	PSOUT
	JRST	(D)

DOHLT:	HRROI	A,[ASCIZ/
Bye
/]
	JSYS	PSOUT
	JSYS	HALTF
	JRST	SAIL			;restart if continued

DSCR	Routines to print out info
⊗;

QUERY:	HRROI	A,[ASCIZ!

<filelist>	;compile file
←<filelist>	;compile with no binary
<filelist>,	;compile, subcommand mode
<filelist>←	;compile, load with DDT
<filelist>,←	;compile, load with DDT, subcommand

↑U  start over
↑Q  quit
?   this list

!]
	JSYS	PSOUT
	JRST	(D)			;RETURN
SUBQRY:
	HRROI	A,[ASCIZ!

Type one of the following characters:
↑U  start over
↑Q  quit
↑R  non-standard .REL file
↑L  listing file
/   switch specification
?   this list

Legal switches include the following, where <num> is a number.
Edit switches with ↑R, ↑X, ↑A or rubout.

G  load after compilation
T  load with DDT
R  double parse stacks
C  produce a cref listing
D  double define PDL
P  double PDL
Q  double string PDL
H  make sharable (default on TENEX)
I  make non-sharable
K  KOUNT feature
<num>S	string space
<num>F	listing format --

 
!]
	JSYS	PSOUT
	JRST	(D)			;RETURN

NXTJFN:	MOVSI	A,100001
	MOVE	B,NXTPTR
	CAMN	B,NAMPTR
	  JRST	NXTDUN
	JSYS	GTJFN
	   CAIA					;ERROR RETURN
	JRST	NXTJF1
	MOVEM	B,NXTPTR			;SAVE NXTPTR
SYSERR:	ERR <Confusion in command scanner>,1
	JRST	NXTJFN

NXTJF1:	MOVEM	B,NXTPTR
	POPJ	P,

NXTDUN:	SETO	A,
	POPJ	P,

DSCR	Typing routines
⊗;

.BACKUP:	
	SKIPE	A,CMDJFN
	  JRST	.BACK1
	MOVEI	A,100
	JSYS	BKJFN
	  JFCL
	POPJ	P,
.BACK1:	
	JSYS	BKJFN
	  JFCL
	MOVEM	A,CMDJFN
	POPJ	P,

TYI:
	ILDB	A,SWTPTR
	POPJ	P,


.NXTCHR:
	PUSH	P,B
	SKIPN	A,CMDJFN
	  JRST	.NXT1
	JSYS	BIN
	MOVEM	A,CMDJFN
.NXTRET:
	MOVE	A,B	
	POP	P,B
	POPJ	P,		 
.NXT1:
	MOVEI	A,100			;PRIMARY INPUT
	JSYS	BIN
	JRST	.NXTRET

DSCR	Long form GTJFN tables.
⊗;

EREL:	XWD	400000,0			;NEW VERSION
	XWD	100,101
	0
	0
	XWD	-1,DEFFLN
	XWD	-1,[ASCIZ/REL/]
	BLOCK	3

EREL1:	XWD 	400000,0
	XWD	377777,377777
	0
	0
	XWD	-1,DEFFLN
	XWD	-1,[ASCIZ/REL/]
	BLOCK	3

ELST:	XWD	400000,0			;NEW VERSION
	XWD	100,101
	0
	0
       	XWD	-1,DEFFLN
	XWD	-1,[ASCIZ/LST/]
	BLOCK	3

ESAI:	XWD	100000,0
	XWD	100,101
	0
	0
	0
	XWD	-1,[ASCIZ/SAI/]
	BLOCK	3

;used by REQUIRE SOURCE!FILE
ESRC:	XWD	100000,0
	XWD	377777,377777
	BLOCK	3
	XWD	-1,[ASCIZ/SAI/]
	BLOCK	3

;when REQUIRE SOURCE!FILE fails, use this
ESRCT:	XWD	100000,0
	XWD	100,101
	BLOCK	3
	XWD	-1,[ASCIZ/SAI/]
	BLOCK	3


;  ENTER HERE FROM SCAN WHEN EOF IS REACHED AND ANOTHER
;  FILE IS NEEDED. IT IS AN ERROR IF NO MORE ARE LEFT

FILEIN:
	MOVE	TBITS2,SCNWRD
	SKIPE	SRCDLY			;IF ON, NOT END OF FILE, BUT SWITCH IN
	 JRST	 GETSR2
	TLNE	TBITS2,INSWT	;TIME TO SWITCH BACK TO PREV SOURCE FILE?
	 JRST	 UNSWT		;YES

GETSR2:	SETZ	A,
	EXCH	A,SRCDLY
	JUMPN	A,GETSWT
	PUSHJ	P,NXTJFN
	JUMPG	A,GETSR3
	POPJ	P,		;FAIL RETURN, NOSKIP

EXTERNAL TENXFI,CATCHR

GETSWT:	EXCH	SP,STPSAV
	PUSH	SP,PNAME	;CONVERT FILE NAME TO TENEX FORMAT
	PUSH	SP,PNAME+1
	PUSHJ	P,TENXFI
	PUSH	P,[0]
	PUSHJ	P,CATCHR	;AND PUT A NULL FOR GTJFN
	POP	SP,PNAME+1
	POP	SP,PNAME
	EXCH	SP,STPSAV
	MOVE	B,PNAME+1	;BYTEPOINTER
	MOVEI	A,ESRC		;LONG FORM -- TABLE ABOVE
	JSYS	GTJFN
	  JRST	GETSW1
	JRST	GETSR3		;SWITCHING DATA AREAS ALREADY DONE.

GETSW1:	ERR	<Cannot GTJFN REQUIREd file, type RETURN to GTJFN from terminal>,1
	HRROI	A,[ASCIZ/
Filename  */]
	JSYS	PSOUT
	MOVEI	A,ESRCT		;LONG FORM
	SETZ	B,		;GO TO TTY DIRECTLY
	JSYS	GTJFN
	  JRST	GETSW1		;ANOTHER ERROR!
	JRST	GETSR3

GETSRC:
GETSR1:	PUSHJ	P,NXTJFN
	JUMPLE	A,[ERR	<Need a source file>]
GETSR3:	MOVEM	A,SRCJFN
	JSYS	DVCHR			;GET THE DEVICE CHARS
	PUSH	P,B			;SAVE THEM
	PUSH	P,C
	MOVEI	A,101			;COMPARE TO THE CONTROLLING TERMINAL
	JSYS	DVCHR
	SETO	D,			;ASSUME THEY MATCH
	CAMN	B,-1(P)			;BUT DO THEY
	CAME	C,(P)
	  SETZ	D,			;NO MATCH
	MOVEM	D,TTYSRC		;SAY WHETHER OR NOT IT IS THE CONTROLLING TERMINAL
	SUB	P,X22			;ADJUST STACK
	JUMPN	D,OPNED			;DONT OPEN THE TTY -- WONT USE JFN ANYWAY

OPNUP:	MOVE	A,SRCJFN		
	MOVE	B,[XWD 440000,200000]	;OPEN SOURCE - NOTE IS 36-BIT
	JSYS	OPENF
	  ERR	<Can't open source file>

;NOW ALLOCATE INPUT BUFFER FOR SRCJFN, SET RELEVANT SWITCHED DATA
OPNED:	HRRZI	C,SRCBSZ+1	;PLUS 1 FOR EOB NULL WORD
	PUSHJ	P,CORGET
	 ERR	<DRYROT at CC:  No core for allocation>
	MOVEM	B,BUFADR
	ADD	C,B
	MOVE	TEMP,B
	HRLS	TEMP
	ADDI	TEMP,1
	SETZM	-1(TEMP)
	BLT	TEMP,-1(C)	;CLEAR OUT BUFFER, SINCE CORGET DOESNT
	SUBI	B,1
	HRLI	B,700		;MAKE THE KIND OF BP THAT POINTS A WORD EARLY
	MOVEM	B,SRCPNT
	SETZM	CRIND		
	HRRZI	1,37		;EOL
	SKIPE	SWTLNK
	JSYS	PBOUT		;TO TTY 
	MOVE	1,LININD
	HRROI	1,INDTAB(1)
	JSYS	PSOUT
	HRROI	A,SRCFLN	
	HRRZ	B,SRCJFN
	SETZ	C,
	JSYS	JFNS		;PRINT SRCFIL NAME TO TTY
	IDPB	C,A		;TERMINATING NULL CHAR
	HRROI	A,SRCFLN	;NOW PRINT THE NAME
	JSYS	PSOUT		
	SKIPN	TTYSRC		;IS THE CONTROLLING TERMINAL THE SOURCE?
	  JRST	.+3		;NO
	HRROI	A,[ASCIZ/
Type ↑Z for EOF, ↑R, ↑X, ↑A to edit.
/]
	JSYS	PSOUT
	AOS	(P)		;SUCCESS -- SKIP RETURN FROM FILEIN
	POPJ	P,




SUBTTL	Production Interpreter
>;TENX